home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / brklyprl.lha / Comp / partobj.pl < prev    next >
Text File  |  1989-04-14  |  4KB  |  119 lines
  1.  
  2. /* Copyright (C) 1988, 1989 Herve' Touati, Aquarius Project, UC Berkeley */
  3.  
  4. /* Copyright Herve' Touati, Aquarius Project, UC Berkeley */
  5.  
  6. % Convert unraveled code into partial object code:
  7.  
  8. partobj([Head|BodyGoals], [HeadObj|BodyObj], Perms) :-
  9.     Head=..[_|Args],
  10.     getputblock(get, Args, HeadObj, 1),
  11.     xpartobj(BodyGoals, Perms, BodyObj, yes), !.
  12.  
  13.  
  14. xpartobj([], _, [], _).
  15. xpartobj([Dis|Rest], Perms, Result, Flag) :-
  16.     Dis=(_;_), !,
  17.     % Initialize permanent variables just before first disjunction:
  18.     initperms(Flag, Perms, Result, [DisCode|RestCode]),
  19.     dispartobj(Dis, Perms, DisCode),
  20.     xpartobj(Rest, Perms, RestCode, no).
  21. xpartobj([Goal|Rest], Perms, [GoalCode|RestCode], Flag) :-
  22.     goalpartobj(Goal, Perms, GoalCode),
  23.     xpartobj(Rest, Perms, RestCode, Flag).
  24.  
  25.     initperms(yes, Perms, [PermInit|R], R) :- !,
  26.         initblock(Perms, PermInit).
  27.     initperms(_, _, R, R).
  28.  
  29. dispartobj((A;B), Perms, (ACode;BCode)) :-
  30.     xpartobj(A, Perms, ACode, no),
  31.     dispartobj(B, Perms, BCode).
  32. dispartobj(A, Perms, ACode) :-
  33.     xpartobj(A, Perms, ACode, no). 
  34.  
  35.  
  36. % Convert goals into their object code:
  37. % Recognizes !, true, unify goals, and calls with simple arguments:
  38.  
  39. % Convert '!' into cut instruction:
  40. goalpartobj(!, _, [cut|Link]-Link).
  41. % Cut in a disjunction is handled for objcode:
  42. goalpartobj('->', _, cutd). % Note: not a list, so objcode is signaled.
  43. % 'true' needs no code:
  44. goalpartobj(true, _, Link-Link).
  45. % translation of unify goals:
  46. goalpartobj(V=W, Perms, [put(_,V,Temp)|Code]-Link) :-
  47.     unify_temp(V, Perms, Temp),
  48.     unify_2ndpart(W, Temp, Code-Link).
  49. % Added clause for VLSI PLM:
  50. % goalpartobj(is(Out,A,Op,B), _, Code-Link) :-
  51. %     compile_options(s),
  52. %     vlsi_instr(Op, Opcode), !,
  53. %     Instr=..[Opcode,x(N),x(M)],
  54. %     Code=[put(T1,A,x(N)),
  55. %           put(T2,B,x(M)),
  56. %           deref(x(N)),
  57. %           deref(x(M)),
  58. %           Instr,
  59. %           put(constant, xF3FFFFFF, x(1)),
  60. %           and(x(1),x(M)),
  61. %           get(T3,Out,x(M))|Link],
  62. %     simple_type(A,T1),
  63. %     simple_type(B,T2),
  64. %     simple_type(Out,T3).
  65. % translation of other goals:
  66. goalpartobj(Goal, _, Code-Link) :-
  67.     Goal=..[Name|Args],
  68.     my_length(Args, Arity),
  69.     getputblock(put, Args, Code-L, 1),
  70.     goal_call(Name, Arity, L, Link).
  71.  
  72.     % Get the temporary variable for unify goals:
  73.     unify_temp(V, Perms, x(8)) :- in(V, Perms), !.
  74.     unify_temp(V, Perms, V).
  75.  
  76.     % Create the call:
  77.     goal_call(Name, Arity, [Name/Arity|L], L) :-
  78.         escape_builtin(Name,Arity), !.
  79.     goal_call(Name, Arity, [call(Name,_)|L], L).
  80.  
  81.     % Get type annotation of simple argument:
  82.     simple_type(A, constant) :- atomic(A), !.
  83.     simple_type(V, _) :- var(V), !.
  84.  
  85. % Code for second argument of '=' predicate:
  86. unify_2ndpart(W, Temp, [get(_,W,Temp)|Link]-Link) :-
  87.     var(W), !.
  88. unify_2ndpart(W, Temp, [get(constant,W,Temp)|Link]-Link) :-
  89.     atomic(W), !.
  90. unify_2ndpart(W, Temp, [get(structure,'.'/2,Temp)|L]-Link) :-
  91.     list(W), !,
  92.     unifyblock(list, W, L-Link).
  93. unify_2ndpart(W, Temp, [get(structure,Name/Arity,Temp)|L]-Link) :- !,
  94.     W=..[Name|Args], my_length(Args, Arity),
  95.     unifyblock(nonlist, Args, L-Link).
  96.  
  97. % Initialization of variables:
  98. % Uses register 8 as a holder.
  99. initblock([], Link-Link).
  100. initblock([V|Vars], [put(_,V,x(8))|Rest]-Link) :-
  101.     initblock(Vars, Rest-Link).
  102.  
  103. % Get or put of all head arguments:
  104. % (If Type is get or put).
  105. getputblock(Type, [A|Args], [X|Rest]-Link, N) :-
  106.     X=..[Type,T,A,x(N)],
  107.     (atomic(A) -> T=constant; true),
  108.     N1 is N+1,
  109.     getputblock(Type, Args, Rest-Link, N1).
  110. getputblock(_, [], Link-Link, _).
  111.  
  112. % Block of unify instructions to unify structures or lists:
  113. unifyblock(nonlist, [], [unify_nil|Link]-Link).
  114. unifyblock(list, V, [unify(cdr,x(8)),get(_,V,x(8))|Link]-Link) :- var(V), !.
  115. unifyblock(list, [], [unify_nil|Link]-Link) :- !.
  116. unifyblock(Type, [A|Args], [unify(T,A)|Rest]-Link) :-
  117.     (atomic(A) -> T=constant; true),
  118.     unifyblock(Type, Args, Rest-Link).
  119.